home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / System source / Mod < prev    next >
Encoding:
Text File  |  1995-11-23  |  7.4 KB  |  189 lines  |  [TEXT/YERK]
  1. \ Module - support for separately compiled modules in Yerk
  2. \ 12/04/84  CBD Version 1
  3. \ 10/22/85  cdn Echo during module load
  4. \ 12/20/85  cdn Reuse target BIN file- so as not to wrestle file from folder
  5. \  7/11/86  cdn Modify flagging technique in BldBits for faster run time
  6. \  7/26/86  cdn Added ^last word defined in module as first 4 bytes
  7. \  8/31/88    rfl ***WARNING***
  8. \                The code to become a module must clear all data areas it uses.
  9. \                If it doesn't, the second pass will have differing bytes
  10. \                than the first pass and bldbits will think they are
  11. \                relocatable addresses!
  12. \ 5/06/93    rfl added 'immediates' to handle marking immediate imports
  13. \ 6/04/93    rfl    sfind now doesn't map to uppercase, as advertised in glossary
  14. \                screate modified for source documentation...screate and sfine
  15. \                moved to 'file' ... 'module' saves doc state and sets to -doc
  16. \ 1/01/94    rfl    change set-file to setNamePtr: topfile
  17. \ 1/05/94    rfl dispose of old module for module compile changed to keep
  18. \                  old install bit.
  19. \ 6/04/94    rfl    fixed old bug. Sometimes a module wouldn't work, even though
  20. \                  it compiled. The problem was that bldbits has to compare
  21. \                  short word by shortword, since it doesn't know where an
  22. \                  address starts. When it finds a word that doesn't compare
  23. \                  from lo to hi pass, it assumes that it is the hi word of
  24. \                  an address. Then it sets the bit to work correctly. If, however,
  25. \                  a 64k boundary exists somewhere in the compiles, then
  26. \                  some hi byte addresses might agree, throwing the bit setting
  27. \                  off by 2. So, I changed the allocation to start correctly at
  28. \                   a 64k boundary before the compilation. THIS MEANS YOU PROBABLY
  29. \                  WILL NEED 128K available in the dictionary to compile a long
  30. \                  module.
  31. \ 11/23/95    rfl    give notice is module compiles to more than 32k
  32.  
  33. Decimal
  34.  
  35. \ use: You must define the imports for a module in the resident
  36. \ portion of your application with the statement:
  37. \     FROM moduleName IMPORT{ imp0 ... impN }
  38. \ This will create a module definition for filename "moduleName"
  39. \ and import definitions for all imported names.
  40. \ Later, you must build the module with the statement
  41. \    module "moduleName"
  42. \ This will look up the mod def for moduleName, and generate a
  43. \ relocatable module from its source file.
  44. \ After the module is built, any reference to one of the imported names
  45. \ will cause the module to be loaded. Imported names are local to
  46. \ the vocabulary that they are defined in.
  47.  
  48. \ Define names to be imported from module - FROM modName IMPORT{ ... }
  49. \ ( -- modDefCfa )
  50. : From   modDef latest Name>  ;
  51.  
  52. \ imp def data consists of |mod0cfa|offs|
  53. \ code to execute for an import def
  54. 1 codefields
  55.     Do..  dup  4+ w@        \ @IMP
  56.         swap @ 4+ execute    \ exec 1cfa of MODULE def
  57.     ..End
  58.  
  59. 2drop
  60. Constant impCfa
  61.  
  62. \ build an import definition for the name at HERE
  63. : ,import { imp# modCfa -- }
  64.     here 1 and IF 0 c, THEN
  65.     createHdr -4 allot impCfa ,    \ create link, cfa
  66.     modCfa , imp# 4* 4+ w, latest modCfa 16 + ! ;    \ last import link
  67.  
  68. \ parse the export defs for module
  69. : Import{   { modCfa -- }   0
  70.     BEGIN  bl word  firstChr ascii } <>
  71.     WHILE  dup modCfa  ,import  1+    \ build import defs
  72.     REPEAT  modCfa  20 + w!  ;        \ save # of imports
  73.  
  74. 0 value  modStart    \ beginning addr of module during build
  75. 0 value  moduleCfa    \ cfa of module def during build
  76. 0 value  cleanMod    \ true if clean compile
  77.  
  78. \ clear object area of bitmap and create the indexed hdr
  79. : clearBits { addr len -- }    \ len is of overlay bytes
  80.     len bitsLen -> len  addr len  erase
  81.     ' bitMap addr ! len 8 - addr 6 + w! 1 addr 4+ w! ;
  82.  
  83. \ Build a bitmap containing relocation flags for all words in an application.
  84. : bldBits { base len \ hibase inc -- }
  85.     base len + -> hibase
  86.     base len 2* + 4+ -> bits
  87.     bits 4- len clearBits
  88.     len 0 DO
  89.         2 -> inc
  90.         base i+ w@  hiBase i+ w@ <>
  91.         IF i dup 1+ len >=
  92.             IF   1-
  93.             ELSE base i+ 2+ w@  hiBase i+ 2+ w@ <>
  94.                 IF 4 -> inc ELSE 1- THEN
  95.             THEN
  96.             2/ bits set: bitmap
  97.         THEN
  98.     inc +LOOP ;
  99.  
  100. \ build bitmap for overlay starting at word in stream
  101. : bldOvl { loBase hiBase \ len ^parms -- base totalLen }
  102.     hiBase loBase - -> len  loBase len bldBits
  103.     type# 185 ( module code size: ) len . ." bytes " cr
  104.     bits limit: [ bits ] + 4+ -> ^parms
  105.     len ^Parms w!  hiBase ^parms 2+ !            \ build parms area
  106.     hibase ^parms hiBase - 6 ( parmsLen ) +  ;    ( -- base len )
  107.  
  108. \ Save binary overlay for an application that was loaded twice
  109. : saveBin { loBase hiBase -- }
  110.     loBase hiBase bldovl    ( base len )
  111.     create: fFcb ?error 138
  112.     latest pfa lfa                \ find link field of first word in module
  113.     BEGIN @ pfa lfa dup @ hiBase < UNTIL
  114.     dup @ swap 0 over !            \ ( link addr )  zero out link field
  115.     2swap write: fFcb >R ! R> ?error 140
  116.     binType saveSig set: fFcb    \ set creator, type
  117.     close: fFcb drop ;
  118.  
  119. \ reserve space for export vectors and save modStart
  120. ( #exports -- )
  121. : ,Exports   here -> modStart  4* 4+ reserve ;
  122.  
  123. \ initialize the export vectors for module just compiled
  124. : !exports { modCfa \ thisImp -- }
  125.     modCfa 16 + @  -> thisImp    \ link to nfa of last import
  126.     BEGIN thisImp n>count sFind 0= ?error 143
  127.         drop dup nfa thisImp =
  128.         IF cr thisImp .name msg# 144 0 -> cleanMod
  129.         ELSE  dup nfa c@ thisImp c!    \ copy name flags into import definition
  130.             cfa thisImp name>
  131.             8+ w@ modStart + !    \ store export cfa
  132.         THEN    thisImp name> >link @ dup -> thisImp  Name> modCfa =
  133.     UNTIL ;        \ loop until back to module def
  134.  
  135. \ module builder - loads module source twice, relocates it, saves to disk
  136. \ use: mBuild "modFile"
  137. : Module { \ loMod hiMod mecho docState -- } docs -> docstate -docs
  138.     1 -> cleanMod  0 -> moduleCFA
  139.     " TASK" sCreate
  140.     here $ 10000 + $ f0000 and here - 0 max reserve
  141.                                 \ Modules are limited to 32k in length
  142.                                 \ TO make sure that the address compares work
  143.                                 \ need to start on a 64k boundary for compiling.
  144.     new: loadFile setName: topFile
  145.     cr type# 176 ( Compiling module: ) getName: topFile type cr
  146.     Here -> loMod interpret: topFile    \ *** FIRST PASS
  147.     here loMod - $ 8000 > ?error 194
  148.     loMod @ latest or loMod !    \ mark last def (hi byte is flags)
  149.     cleanMod 0= ?error 145
  150.     moduleCfa >name n>count binName name: fFcb    \ set name of binary file
  151.     decho -> mecho -echo        \ preserve load echo flag
  152.     cr getName: fFcb type type# 177 ( Second pass…) cr
  153.     topFile 80 erase  setNamePtr: topfile    \ fresh fcb (for HFS compatability)
  154.     here -> hiMod interpret: topFile    \ *** SECOND PASS
  155.     hiMod @ latest or hiMod !    \ mark last def (hi byte is flags)
  156.     remove: loadfile
  157.     mecho -> decho                \ restore load echo flag
  158.     hiMod loMod - 0= ?error 146
  159.     loMod hiMod saveBin
  160.     ." Binary module " getName: fFcb type ."  successfully saved " cr
  161.     moduleCFA 12 +
  162.     dup @ -dup IF $ 0fffffff and killPtr THEN    \ purge old module from memory
  163.     dup @ $ 80000000 and swap !                 \ and remove pointer from cfa+12
  164.     " TASK" sFind  0 -> cleanMod
  165.     IF drop dup nfa -> dp lfa @ current ! THEN docState -> docs ;
  166.  
  167. \ begin a module source definition
  168. : :Module
  169.     @pfa cfa dup @ modCode <> ?error 147
  170.     dup -> moduleCfa cleanMod
  171.     0= ?error 164 cr    \ Use "Module" loader for modules
  172.     moduleCFA ?mlock ?error 188    \ module is locked
  173.     20 + w@ dup . type# 178 ( export entries ) cr
  174.     ,Exports   ;    \ build export vectors
  175.  
  176. \ Cause the module to remain locked after execution terminates
  177. : Locked 1 modStart c! ;
  178.  
  179. \ end a module source definition
  180. : ;Module
  181.     moduleCfa  dup 0= ?error 148
  182.     !exports  ;
  183.  
  184. \ if any of the imported words are defined in the module as immediate,
  185. \   you should move all of them to the last of the import list and
  186. \   then add n immediates to mark them as such.
  187. : immediates { num \ addr -- } latest -> addr
  188.     num 0 DO addr 64 toggle addr 1 traverse 1+ @ -> addr LOOP ;
  189.